home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / copyRing.tcl < prev    next >
Text File  |  1996-08-15  |  3KB  |  130 lines
  1. # Implementation of Emacs's kill ring. This is a paste ring.
  2.  
  3. if {[catch {set renamedRing}]} {
  4.     set renamedRing 1
  5.     rename copy oldCopy
  6.     rename cut oldCut
  7.     rename paste oldPaste
  8. }
  9.  
  10. set ringDepth     5
  11. set ringIn         0
  12. set ringOut         0
  13. set pasteStart     0
  14. set pasteFinish    0
  15.  
  16.  
  17. proc copy&Append {} {
  18.     set old [getScrap]
  19.     putScrap "$old[getSelect]"
  20.     message "Appended"
  21. }
  22.  
  23.  
  24. proc cut&Append {} {
  25.     set old [getScrap]
  26.     putScrap "$old[getSelect]"
  27.     deleteText [getPos] [selEnd]
  28.     message "Appended"
  29. }
  30.  
  31.  
  32.  
  33. proc copy {} {
  34.     global copyring ringDepth ringIn
  35.     
  36.     set len [expr {[selEnd] - [getPos]}]
  37.     if {!$len} {
  38.         if {[getMark] < [getPos]} {
  39.             set text [getText [getMark] [getPos]]
  40.             set len [expr [getPos] - [getMark]]
  41.         } else {
  42.             set text [getText [getPos] [getMark]]
  43.             set len [expr [getMark] - [getPos]]
  44.         }
  45.         if {![string length $text]} return
  46.     } else {
  47.         set text [getSelect]
  48.     }
  49.  
  50.  
  51.     set copyring([expr {$ringIn % $ringDepth}]) $text
  52.     incr ringIn
  53.     
  54.     oldCopy
  55. }
  56.  
  57.  
  58. proc cut {{rect 0}} {
  59.     global copyring ringDepth ringIn intelCutPaste
  60.     
  61.     set len [expr {[selEnd] - [getPos]}]
  62.     if {!$len} {
  63.         if {[getMark] < [getPos]} {
  64.             set text [getText [getMark] [getPos]]
  65.             set len [expr [getPos] - [getMark]]
  66.         } else {
  67.             set text [getText [getPos] [getMark]]
  68.             set len [expr [getMark] - [getPos]]
  69.         }
  70.         if {![string length $text]} return
  71.     } else {
  72.         set text [getSelect]
  73.     }
  74.  
  75.     set copyring([expr {$ringIn % $ringDepth}]) $text
  76.     incr ringIn
  77.  
  78.     oldCut
  79.  
  80.     if {$intelCutPaste && !$rect} {
  81.         if {[isWhite 0] && [isWhite -1]} {
  82.             backSpace
  83.         }
  84.     }
  85. }
  86.  
  87. proc paste {{rect 0}} {
  88.     global copyring ringDepth ringIn ringOut intelCutPaste pasteStart pasteFinish
  89.     set intel 0
  90.     set ringOut [expr {($ringIn - 1) % $ringDepth}]
  91.     if {!$rect && $intelCutPaste} {
  92.         set left -1
  93.         set right [expr [selEnd] - [getPos]]
  94.         if {[isWhite $right] && [isChar $left]} {
  95.             clear
  96.             insertText " "
  97.         } elseif {[isWhite $left] && [isChar $right]} {set intel 1}
  98.     }
  99.     oldPaste
  100.     set pasteStart [getMark]
  101.     set pasteFinish [getPos]
  102.     if {$intel && ([lookAt [expr [getPos]-1]] != "\r")} {
  103.         insertText " "
  104.     }
  105. }
  106.  
  107.  
  108. proc isWhite {off} {
  109.     set c [lookAt [expr [getPos] + $off]]
  110.     return [expr {($c == " ")}]
  111. }
  112.  
  113. proc isChar {off} {
  114.     set c [lookAt [expr [getPos] + $off]]
  115.     return [expr {[string match {[a-z]} $c]}]
  116. }
  117.  
  118.     
  119. proc pastePop {} {
  120.     global copyring ringDepth ringIn ringOut pasteFinish pasteStart
  121.     
  122.     if {!$ringIn} { beep; return}
  123.     
  124.     set ringOut [expr $ringOut-1]
  125.     if {$ringOut < 0} {set ringOut [expr (($ringDepth > $ringIn) ? $ringIn : $ringDepth) - 1]}
  126.     
  127.     replaceText $pasteStart $pasteFinish $copyring($ringOut)
  128.     set pasteFinish [expr $pasteStart + [string length $copyring($ringOut)]]
  129. }
  130.